home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / calc16.zip / DEMO2.PRG < prev    next >
Text File  |  1993-04-24  |  4KB  |  114 lines
  1.  
  2. // CalcHard.prg - Complex demo of the calculator
  3.  
  4. #include "inkey.ch"
  5.  
  6. Function CalcHard()
  7. Local getlist:={}, nInteger, nDontWork, nFloating, cText, nAnother
  8.  
  9.    Set Scoreboard OFF
  10.  
  11.    CLS
  12.  
  13.    CalcReg(00000)                  //insert your reg. no. here
  14.    Set Key K_ALT_O to Calculator
  15.  
  16.    CalcInit("W+/R")                //try a Red Calculator
  17.  
  18.    //This will cause F2 to multiply anything by 2
  19.    SetKey(K_F2,{|p,line,var,no| If(p="CALCULATOR", no * 2, NIL)})
  20.  
  21.    //This will cause F3 to do a square root
  22.    SetKey(K_F3,{|p,line,var,no| If(p="CALCULATOR", Sqrt(no), NIL)})
  23.  
  24.    //This will cause the $ dollar sign to set fixed decimals to 2
  25.    SetKey(Asc("$"),{|p|If(p="CALCULATOR", "F2", NIL)})
  26.  
  27.    //This will cause the calc to call CalcProc() when beginning and when
  28.    // ending to display a personalized help screen.
  29.    CalcUDF({|a,b,c,d,e,f,g,h|CalcProc(a,b,c,d,e,f,g,h)})
  30.  
  31.    nInteger :=7
  32.    nDontWork:=6
  33.    nAnother:=-5
  34.    nFloating:=1.23
  35.    cText    :=Space(8)
  36.  
  37.    @ 9,5 Get nInteger
  38.    @10,5 Get nDontWork
  39.    @11,5 Get nAnother
  40.    @12,5 Get nFloating
  41.    @13,5 Get cText
  42.  
  43.    @ 9,20 Say     "< The integer will transfer to the calculator."
  44.    @10,20 Say     "< You can disable the calculator on specific fields."
  45.    @11,20 Say     "< Negative."
  46.    @12,20 Say     "< Floating Point transfer and return (Ctrl-Enter)."
  47.    @13,20 Say     "< Text pasting. (press Ctrl-Enter inside calculator)."
  48.  
  49.    @15,5 Say "Press ALT-O to access the calculator"
  50.  
  51.    READ
  52.  
  53. Return NIL
  54.  
  55.  
  56. Function CalcProc(cProc, nVer, cVar, nDisp, cDisp, nMode, cColor, nKey)
  57. * cProc     = Procedure (always "CALCULATOR")
  58. * nVer      = Version number (10 through 13, for ver 1.0 through ver 1.3)
  59. * cVar      = Variable name of GET field called from
  60. * nDisp     = Numeric display of calculator
  61. * cDisp     = Character display of calculator
  62. * cWhen     = Either "INIT" when beginning calc or "END" when leaving calc
  63. * cColor    = Color when entering calculator
  64. * nKey      = Lastkey pressed
  65. *             * NOTE: Current color will always be "N/W", so use cColor
  66. *             *       to determine color upon entry to calculator.
  67. Static cSaveScreen
  68. Local xRetVal
  69.  
  70.    If nMode = 0 //INIT: called going into the calculator
  71.  
  72.       //First, if this variable is "nDontWork," then abort (no calculator)
  73.       If cVar = "NDONTWORK"
  74.          Return .T.           // True = ABORT CALC
  75.       Endif
  76.  
  77.       //Everything ok, change color to W+/B (if color display)
  78.       // Also, NO need to SAVE COLOR, calculator does that.
  79.       If(IsColor(),SetColor("W+/B"),NIL)
  80.  
  81.       //Everything ok, save screen, popup help screen
  82.       cSaveScreen:=SaveScreen(0,29,7,51)
  83.       @ 0,29 to 7,51 Double
  84.       @ 1,30 Say " F2 = Display x 2    "
  85.       @ 2,30 Say " F3 = Square Root    "
  86.       @ 3,30 Say "  $ = Fix 2 decimals "
  87.       @ 4,30 Say "  H = Calculator Help"
  88.       @ 5,30 Say " F9 = Add Tax to val "
  89.       @ 6,30 Say " F10= Put Tax in Mem "
  90.  
  91.       xRetVal := "F3" //fix decimals to 3 on INITIAL CALL
  92.  
  93.    Elseif nMode=3 //TERM: called going out of the calculator
  94.  
  95.       RestScreen(0,29,7,51,cSaveScreen)
  96.  
  97.    Elseif nMode=2 //Key Exception
  98.  
  99.       Do Case
  100.          Case nKey = K_F9   //multiply TAX to current value
  101.             xRetVal := nDisp * 1.0775
  102.  
  103.          Case nKey = K_F10  //stuff TAX into Memory!
  104.             CalcMemory( 1.0775 )
  105.  
  106.       Endcase
  107.  
  108.    Endif
  109.  
  110. // (On INITIAL call from the calculator, if you return a character string,
  111. //  it will be "keyboarded" into the calculator (remember Set Typeahead)).
  112.  
  113. Return xRetVal
  114.